home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tvtoys04.zip / HELPFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  26KB  |  1,072 lines

  1. (***************************************************************************
  2.   Helpfile unit
  3.   Improved help file
  4.   PJB November 7, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Free patches, use at your own risk. All warranties void.
  6.   If even more modified, please state so if you pass this around.
  7.  
  8.   This HelpFile patched to allow back tracking and external access to
  9.   help topics (search for "HelpExtensions").
  10.   Some Borland bugs fixed (search for "fix"). Handles empty topics.
  11.   Doesn't spill long topic links any more.
  12.  
  13.   Define RangeFix to fix more Borland bugs (search for "Int->Word fix"):
  14.     Borland sometimes uses integers for help topics even though they are
  15.     words, RangeFix changes them into words so you can compile with $R+.
  16.     If you define RangeFix, you'll get a compile error if you try to
  17.     compile TVHC. In that case, modify TVHC to this (change to RefType):
  18.  
  19.     procedure HandleCrossRefs(var S: TStream; XRefValue: RefType); far; { Int->Word fix }
  20.  
  21.  
  22.   This HelpFile requires an exact topic match. To respond to a range of
  23.   help topics, define several in a row like this:
  24.  
  25.     .topic  First,F2,F3,F4
  26.  
  27.   Added PPalette casts, Config and Prefs. Remembers last selected topic.
  28. ***************************************************************************)
  29. {************************************************}
  30. {                                                }
  31. {   Turbo Vision Demo                            }
  32. {   Copyright (c) 1992 by Borland International  }
  33. {                                                }
  34. {************************************************}
  35.  
  36. unit HelpFile;
  37.  
  38. {$I toyCfg}
  39.  
  40. {$IFDEF DPMI}
  41.  {$B-,X+}
  42. {$ELSE}
  43.  {$B-,F+,O+,X+}
  44. {$ENDIF}
  45.  
  46. {$IFNDEF RangeFix}
  47.  {$R-}              (* Borland bugs require $R- *)
  48. {$ENDIF}
  49.  
  50. interface
  51.  
  52. uses
  53.   Drivers, Objects, Views,
  54.   toyPrefs;
  55.  
  56. const
  57.   CHelpColor      = #$37#$3F#$3A#$13#$13#$30#$3E#$1E;
  58.   CHelpBlackWhite = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  59.   CHelpMonochrome = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  60.   CHelpViewer     = #6#7#8;
  61.   CHelpWindow     = #128#129#130#131#132#133#134#135;
  62.  
  63. type
  64.  
  65.  {$IFDEF RangeFix}
  66.   RefType = Word;                       { Int->Word fix }
  67.  {$ELSE}
  68.   RefType = Integer;
  69.  {$ENDIF}
  70.  
  71. { TParagraph }
  72.  
  73.   PParagraph = ^TParagraph;
  74.   TParagraph = record
  75.     Next: PParagraph;
  76.     Wrap: Boolean;
  77.     Size: Word;
  78.     Text: record end;
  79.   end;
  80.  
  81. { THelpTopic }
  82.  
  83.   TCrossRef = record
  84.     Ref: Word;
  85.     Offset: Integer;
  86.     Length: Byte;
  87.   end;
  88.  
  89.   PCrossRefs = ^TCrossRefs;
  90.   TCrossRefs = array[1..10000] of TCrossRef;
  91.   TCrossRefHandler = procedure (var S: TStream; XRefValue: RefType);  { Int->Word fix }
  92.  
  93.   PHelpTopic = ^THelpTopic;
  94.   THelpTopic = object(TObject)
  95.     constructor Init;
  96.     constructor Load(var S: TStream);
  97.     destructor Done; virtual;
  98.     procedure AddCrossRef(Ref: TCrossRef);
  99.     procedure AddParagraph(P: PParagraph);
  100.     procedure GetCrossRef(I: Integer; var Loc: TPoint; var Length: Byte;
  101.       var Ref: Word);
  102.     function GetLine(Line: Integer): String;
  103.     function GetNumCrossRefs: Integer;
  104.     function NumLines: Integer;
  105.     procedure SetCrossRef(I: Integer; var Ref: TCrossRef);
  106.     procedure SetNumCrossRefs(I: Integer);
  107.     procedure SetWidth(AWidth: Integer);
  108.     procedure Store(var S: TStream);
  109.   private
  110.     Paragraphs: PParagraph;
  111.     NumRefs: Integer;
  112.     CrossRefs: PCrossRefs;
  113.     Width: Integer;
  114.     LastOffset: Integer;
  115.     LastLine: Integer;
  116.     LastParagraph: PParagraph;
  117.     function WrapText(var Text; Size: Integer; var Offset: Integer;
  118.       Wrap: Boolean): String;
  119.   end;
  120.  
  121. { THelpIndex }
  122.  
  123.   PIndexArray = ^TIndexArray;
  124.   TIndexArray = array[0..16380] of LongInt;
  125.  
  126.   PContextArray = ^TContextArray;
  127.   TContextArray = array[0..16380] of Word;
  128.  
  129.   PHelpIndex = ^THelpIndex;
  130.   THelpIndex = object(TObject)
  131.     constructor Init;
  132.     constructor Load(var S: TStream);
  133.     destructor Done; virtual;
  134.     function Position(I: Word): Longint;
  135.     procedure Add(I: Word; Val: Longint);
  136.     procedure Store(var S: TStream);
  137.   private
  138.     Size: Word;
  139.     Used: Word;
  140.     Contexts: PContextArray;
  141.     Index: PIndexArray;
  142.     function Find(I: Word): Word;
  143.   end;
  144.  
  145. { THelpFile }
  146.  
  147.   PHelpFile = ^THelpFile;
  148.   THelpFile = object(TObject)
  149.     Stream: PStream;
  150.     Modified: Boolean;
  151.    {$IFDEF HelpExtensions}
  152.     HelpAlreadyPopped: Boolean;                 (* "First time" indicator *)
  153.    {$ENDIF}
  154.     constructor Init(S: PStream);
  155.     destructor Done; virtual;
  156.     function GetTopic(I: Word): PHelpTopic;
  157.     function InvalidTopic: PHelpTopic;
  158.     procedure RecordPositionInIndex(I: RefType);    { Int->Word fix }
  159.     procedure PutTopic(Topic: PHelpTopic);
  160.   private
  161.     Index: PHelpIndex;
  162.     IndexPos: LongInt;
  163.   end;
  164.  
  165. { THelpViewer }
  166.  
  167.   PHelpViewer = ^THelpViewer;
  168.   THelpViewer = object(TScroller)
  169.     HFile: PHelpFile;
  170.     Topic: PHelpTopic;
  171.     Selected: Integer;
  172.     constructor Init(var Bounds: TRect; AHScrollBar,
  173.       AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
  174.     destructor Done; virtual;
  175.     procedure ChangeBounds(var Bounds: TRect); virtual;
  176.     procedure Draw; virtual;
  177.     function GetPalette: PPalette; virtual;
  178.     procedure HandleEvent(var Event: TEvent); virtual;
  179.   end;
  180.  
  181. { THelpWindow }
  182.  
  183.   PHelpWindow = ^THelpWindow;
  184.   THelpWindow = object(TWindow)
  185.     constructor Init(HFile: PHelpFile; Context: Word);
  186.     function GetPalette: PPalette; virtual;
  187.   end;
  188.  
  189. const
  190.   RHelpTopic: TStreamRec = (
  191.      ObjType: 10000;
  192.      VmtLink: Ofs(TypeOf(THelpTopic)^);
  193.      Load:    @THelpTopic.Load;
  194.      Store:   @THelpTopic.Store
  195.   );
  196.  
  197. const
  198.   RHelpIndex: TStreamRec = (
  199.      ObjType: 10001;
  200.      VmtLink: Ofs(TypeOf(THelpIndex)^);
  201.      Load:    @THelpIndex.Load;
  202.      Store:   @THelpIndex.Store
  203.   );
  204.  
  205. procedure RegisterHelpFile;
  206.  
  207. procedure NotAssigned(var S: TStream; Value: RefType);    { Int->Word fix }
  208.  
  209. const
  210.   CrossRefHandler: TCrossRefHandler = NotAssigned;
  211.  
  212. implementation
  213.  
  214. { THelpTopic }
  215.  
  216. constructor THelpTopic.Init;
  217. begin
  218.   inherited Init;
  219.   LastLine := MaxInt;
  220. end;
  221.  
  222. constructor THelpTopic.Load(var S: TStream);
  223.  
  224. procedure ReadParagraphs;
  225. var
  226.   I, Size: Integer;
  227.   PP: ^PParagraph;
  228. begin
  229.   S.Read(I, SizeOf(I));
  230.   PP := @Paragraphs;
  231.   while I > 0 do
  232.   begin
  233.     S.Read(Size, SizeOf(Size));
  234.     GetMem(PP^, SizeOf(PP^^) + Size);
  235.     PP^^.Size := Size;
  236.     S.Read(PP^^.Wrap, SizeOf(Boolean));
  237.     S.Read(PP^^.Text, Size);
  238.     PP := @PP^^.Next;
  239.     Dec(I);
  240.   end;
  241.   PP^ := nil;
  242. end;
  243.  
  244. procedure ReadCrossRefs;
  245. begin
  246.   S.Read(NumRefs, SizeOf(Integer));
  247.   GetMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  248.   if CrossRefs <> nil then
  249.     S.Read(CrossRefs^, SizeOf(TCrossRef) * NumRefs);
  250. end;
  251.  
  252. begin
  253.   inherited Init;                 { BUG fix, for empty topics }
  254.   ReadParagraphs;
  255.   ReadCrossRefs;
  256.                                   {  Width:=0 handled by init }
  257.   LastLine := MaxInt;
  258. end;
  259.  
  260. destructor THelpTopic.Done;
  261.  
  262. procedure DisposeParagraphs;
  263. var
  264.   P, T: PParagraph;
  265. begin
  266.   P := Paragraphs;
  267.   while P <> nil do
  268.   begin
  269.     T := P;
  270.     P := P^.Next;
  271.     FreeMem(T, SizeOf(T^) + T^.Size);
  272.   end;
  273. end;
  274.  
  275. begin
  276.   DisposeParagraphs;
  277.   FreeMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  278.   inherited Done
  279. end;
  280.  
  281. procedure THelpTopic.AddCrossRef(Ref: TCrossRef);
  282. var
  283.   P: PCrossRefs;
  284. begin
  285.   GetMem(P, (NumRefs+1) * SizeOf(TCrossRef));
  286.   if NumRefs > 0 then
  287.   begin
  288.     Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef));
  289.     FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  290.   end;
  291.   CrossRefs := P;
  292.   CrossRefs^[NumRefs] := Ref;
  293.   Inc(NumRefs);
  294. end;
  295.  
  296. procedure THelpTopic.AddParagraph(P: PParagraph);
  297. var
  298.   PP: ^PParagraph;
  299. begin
  300.   PP := @Paragraphs;
  301.   while PP^ <> nil do
  302.     PP := @PP^^.Next;
  303.   PP^ := P;
  304.   P^.Next := nil;
  305. end;
  306.  
  307. procedure THelpTopic.GetCrossRef(I: Integer; var Loc: TPoint;
  308.   var Length: Byte; var Ref: Word);
  309. var
  310.   OldOffset, CurOffset, Offset, ParaOffset: Integer;
  311.   P: PParagraph;
  312.   Line: Integer;
  313. begin
  314.   ParaOffset := 0;
  315.   CurOffset := 0;
  316.   OldOffset := 0;
  317.   Line := 0;
  318.   Offset := CrossRefs^[I].Offset;
  319.   P := Paragraphs;
  320.   while ParaOffset+CurOffset < Offset do
  321.   begin
  322.     OldOffset := ParaOffset + CurOffset;
  323.     WrapText(P^.Text, P^.Size, CurOffset, P^.Wrap);
  324.     Inc(Line);
  325.     if CurOffset >= P^.Size then
  326.     begin
  327.       Inc(ParaOffset, P^.Size);
  328.       P := P^.Next;
  329.       CurOffset := 0;
  330.     end;
  331.   end;
  332.   Loc.X := Offset - OldOffset - 1;
  333.   Loc.Y := Line;
  334.   Length := CrossRefs^[I].Length;
  335.   Ref := CrossRefs^[I].Ref;
  336. end;
  337.  
  338. function THelpTopic.GetLine(Line: Integer): String;
  339. var
  340.   Offset, I: Integer;
  341.   P: PParagraph;
  342. begin
  343.   if LastLine < Line then
  344.   begin
  345.     I := Line;
  346.     Dec(Line, LastLine);
  347.     LastLine := I;
  348.     Offset := LastOffset;
  349.     P := LastParagraph;
  350.   end
  351.   else
  352.   begin
  353.     P := Paragraphs;
  354.     Offset := 0;
  355.     LastLine := Line;
  356.   end;
  357.   GetLine := '';
  358.   while (P <> nil) do
  359.   begin
  360.     while Offset < P^.Size do
  361.     begin
  362.       Dec(Line);
  363.       GetLine := WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
  364.       if Line = 0 then
  365.       begin
  366.         LastOffset := Offset;
  367.         LastParagraph := P;
  368.         Exit;
  369.       end;
  370.     end;
  371.     P := P^.Next;
  372.     Offset := 0;
  373.   end;
  374.   GetLine := '';
  375. end;
  376.  
  377. function THelpTopic.GetNumCrossRefs: Integer;
  378. begin
  379.   GetNumCrossRefs := NumRefs;
  380. end;
  381.  
  382. function THelpTopic.NumLines: Integer;
  383. var
  384.   Offset, Lines: Integer;
  385.   P: PParagraph;
  386. begin
  387.   Offset := 0;
  388.   Lines := 0;
  389.   P := Paragraphs;
  390.   while P <> nil do
  391.   begin
  392.     Offset := 0;
  393.     while Offset < P^.Size do
  394.     begin
  395.       Inc(Lines);
  396.       WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
  397.     end;
  398.     P := P^.Next;
  399.   end;
  400.   NumLines := Lines;
  401. end;
  402.  
  403. procedure THelpTopic.SetCrossRef(I: Integer; var Ref: TCrossRef);
  404. begin
  405.   if I <= NumRefs then CrossRefs^[I] := Ref;
  406. end;
  407.  
  408. procedure THelpTopic.SetNumCrossRefs(I: Integer);
  409. var
  410.   P: PCrossRefs;
  411. begin
  412.   if NumRefs = I then Exit;
  413.   GetMem(P, I * SizeOf(TCrossRef));
  414.   if NumRefs > 0 then
  415.   begin
  416.     if I > NumRefs then Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef))
  417.     else Move(CrossRefs^, P^, I * SizeOf(TCrossRef));
  418.     FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  419.   end;
  420.   CrossRefs := P;
  421.   NumRefs := I;
  422. end;
  423.  
  424. procedure THelpTopic.SetWidth(AWidth: Integer);
  425. begin
  426.   Width := AWidth;
  427. end;
  428.  
  429. procedure THelpTopic.Store(var S: TStream);
  430.  
  431. procedure WriteParagraphs;
  432. var
  433.   I: Integer;
  434.   P: PParagraph;
  435. begin
  436.   P := Paragraphs;
  437.   I := 0;
  438.   while P <> nil do
  439.   begin
  440.     Inc(I);
  441.     P := P^.Next;
  442.   end;
  443.   S.Write(I, SizeOf(I));
  444.   P := Paragraphs;
  445.   while P <> nil do
  446.   begin
  447.     S.Write(P^.Size, SizeOf(Integer));
  448.     S.Write(P^.Wrap, SizeOf(Boolean));
  449.     S.Write(P^.Text, P^.Size);
  450.     P := P^.Next;
  451.   end;
  452. end;
  453.  
  454. procedure WriteCrossRefs;
  455. var
  456.   I: Integer;
  457. begin
  458.   S.Write(NumRefs, SizeOf(Integer));
  459.   if @CrossRefHandler = @NotAssigned then
  460.     S.Write(CrossRefs^, SizeOf(TCrossRef) * NumRefs)
  461.   else
  462.     for I := 1 to NumRefs do
  463.     begin
  464.       CrossRefHandler(S, CrossRefs^[I].Ref);
  465.       S.Write(CrossRefs^[I].Offset, SizeOf(Integer) + SizeOf(Byte));
  466.     end;
  467. end;
  468.  
  469. begin
  470.   WriteParagraphs;
  471.   WriteCrossRefs;
  472. end;
  473.  
  474. function THelpTopic.WrapText(var Text; Size: Integer;
  475.   var Offset: Integer; Wrap: Boolean): String;
  476. type
  477.   PCArray = ^CArray;
  478.   CArray = array[0..32767] of Char;
  479. var
  480.   Line: String;
  481.   I, P: Integer;
  482.  
  483. function IsBlank(Ch: Char): Boolean;
  484. begin
  485.   IsBlank := (Ch = ' ') or (Ch = #13) or (Ch = #10);
  486. end;
  487.  
  488. function Scan(var P; Offset, Size: Integer; C: Char): Integer; assembler;
  489. asm
  490.     CLD
  491.     LES    DI,P
  492.         ADD    DI,&Offset
  493.         MOV    DX,Size
  494.         SUB    DX,&Offset
  495.         OR    DH,DH
  496.         JZ    @@1
  497.         MOV    DX,256
  498. @@1:    MOV    CX,DX
  499.     MOV    AL, C
  500.         REPNE    SCASB
  501.     SUB    CX,DX
  502.         NEG    CX
  503.         XCHG    AX,CX
  504. end;
  505.  
  506. procedure TextToLine(var Text; Offset, Length: Integer; var Line: String);
  507.   assembler;
  508. asm
  509.     CLD
  510.     PUSH    DS
  511.     LDS    SI,Text
  512.         ADD    SI,&Offset
  513.         LES     DI,Line
  514.         MOV    AX,Length
  515.         STOSB
  516.         XCHG    AX,CX
  517.         REP    MOVSB
  518.         POP    DS
  519. end;
  520.  
  521. begin
  522.   I := Scan(Text, Offset, Size, #13);
  523.   if (I >= Width) and Wrap then
  524.   begin
  525.     I := Offset + Width;
  526.     if I > Size then I := Size
  527.     else
  528.     begin
  529.       while (I > Offset) and not IsBlank(PCArray(@Text)^[I]) do Dec(I);
  530.       if I = Offset then
  531.       begin
  532.         I := Offset + Width;
  533.  
  534.         (*******************************************************************
  535.           This is a bug fix to avoid wrapping long topic links
  536.           Note that this changes the default behaviour, words longer than
  537.           the current help window width no longer spill over to the next
  538.           line.
  539.         *******************************************************************)
  540.         while (I<Size) and not IsBlank(PCArray(@Text)^[I]) do
  541.           Inc(I);
  542.         if I<Size then          
  543.           Inc(I);                           (* Skip that blank *)
  544.       end
  545.       else Inc(I);
  546.     end;
  547.     if I = Offset then I := Offset + Width;
  548.     Dec(I, Offset);
  549.   end;
  550.   TextToLine(Text, Offset, I, Line);
  551.   if Line[Length(Line)] = #13 then Dec(Line[0]);
  552.   Inc(Offset, I);
  553.   WrapText := Line;
  554. end;
  555.  
  556. { THelpIndex }
  557.  
  558. constructor THelpIndex.Init;
  559. begin
  560.   inherited Init;
  561.   Size := 0;
  562.   Contexts := nil;
  563.   Index := nil;
  564. end;
  565.  
  566. constructor THelpIndex.Load(var S: TStream);
  567. begin
  568.   S.Read(Used, SizeOf(Used));
  569.   S.Read(Size, SizeOf(Size));
  570.   if Size = 0 then
  571.   begin
  572.     Contexts := nil;
  573.     Index := nil;
  574.   end
  575.   else
  576.   begin
  577.     GetMem(Contexts, SizeOf(Contexts^[0]) * Size);
  578.     S.Read(Contexts^, SizeOf(Contexts^[0]) * Size);
  579.     GetMem(Index, SizeOf(Index^[0]) * Size);
  580.     S.Read(Index^, SizeOf(Index^[0]) * Size);
  581.   end;
  582. end;
  583.  
  584. destructor THelpIndex.Done;
  585. begin
  586.   FreeMem(Index, SizeOf(Index^[0]) * Size);
  587.   FreeMem(Contexts, SizeOf(Contexts^[0]) * Size);
  588.   inherited Done;
  589. end;
  590.  
  591. function THelpIndex.Find(I: Word): Word;
  592. var
  593.   Hi, Lo, Pos: Integer;
  594. begin
  595.   Lo := 0;
  596.   if Used > 0 then
  597.   begin
  598.     Hi := Used - 1;
  599.     while Lo <= Hi do
  600.     begin
  601.       Pos := (Lo + Hi) div 2;
  602.       if I > Contexts^[Pos] then
  603.         Lo := Pos + 1
  604.       else
  605.       begin
  606.         Hi := Pos - 1;
  607.         if I = Contexts^[Pos] then
  608.           Lo := Pos;
  609.       end;
  610.     end;
  611.   end;
  612.   Find := Lo;
  613. end;
  614.  
  615. function THelpIndex.Position(I: Word): Longint;
  616. var
  617.   f : Word;
  618. begin
  619.   f := Find(I);
  620.  
  621.   if Contexts^[f] <> I then                { Fix: Match topic exactly }
  622.     Position := 0
  623.   else
  624.     Position := Index^[f];
  625. end;
  626.  
  627. procedure THelpIndex.Add(I: Word; Val: Longint);
  628. const
  629.   Delta = 10;
  630. var
  631.   P: PIndexArray;
  632.   NewSize: Integer;
  633.   Pos: Integer;
  634.  
  635.   function Grow(P: Pointer; OldSize, NewSize, ElemSize: Integer): Pointer;
  636.   var
  637.     NewP: PByteArray;
  638.   begin
  639.     GetMem(NewP, NewSize * ElemSize);
  640.     if NewP <> nil then
  641.     begin
  642.       if P <> nil then
  643.         Move(P^, NewP^, OldSize * ElemSize);
  644.       FillChar(NewP^[OldSize * ElemSize], (NewSize - Size) * ElemSize, $FF);
  645.     end;
  646.     if OldSize > 0 then FreeMem(P, OldSize * ElemSize);
  647.     Grow := NewP;
  648.   end;
  649.  
  650. begin
  651.   Pos := Find(I);
  652.   if (Contexts = nil) or (Contexts^[Pos] <> I) then
  653.   begin
  654.     Inc(Used);
  655.     if Used >= Size then
  656.     begin
  657.       NewSize := (Used + Delta) div Delta * Delta;
  658.       Contexts := Grow(Contexts, Size, NewSize, SizeOf(Contexts^[0]));
  659.       Index := Grow(Index, Size, NewSize, SizeOf(Index^[0]));
  660.       Size := NewSize;
  661.     end;
  662.     if Pos < Used then
  663.     begin
  664.       Move(Contexts^[Pos], Contexts^[Pos + 1], (Used - Pos - 1) *
  665.         SizeOf(Contexts^[0]));
  666.       Move(Index^[Pos], Index^[Pos + 1], (Used - Pos - 1) *
  667.         SizeOf(Index^[0]));
  668.     end;
  669.   end;
  670.   Contexts^[Pos] := I;
  671.   Index^[Pos] := Val;
  672. end;
  673.  
  674. procedure THelpIndex.Store(var S: TStream);
  675. begin
  676.   S.Write(Used, SizeOf(Used));
  677.   S.Write(Size, SizeOf(Size));
  678.   S.Write(Contexts^, SizeOf(Contexts^[0]) * Size);
  679.   S.Write(Index^, SizeOf(Index^[0]) * Size);
  680. end;
  681.  
  682. { THelpFile }
  683.  
  684. const
  685.   MagicHeader = $46484246; {'FBHF'}
  686.  
  687. constructor THelpFile.Init(S: PStream);
  688. var
  689.   Magic: Longint;
  690. begin
  691.   Magic := 0;
  692.   S^.Seek(0);
  693.   if S^.GetSize > SizeOf(Magic) then
  694.     S^.Read(Magic, SizeOf(Magic));
  695.   if Magic <> MagicHeader then
  696.   begin
  697.     IndexPos := 12;
  698.     S^.Seek(IndexPos);
  699.     Index := New(PHelpIndex, Init);
  700.     Modified := True;
  701.   end
  702.   else
  703.   begin
  704.     S^.Seek(8);
  705.     S^.Read(IndexPos, SizeOf(IndexPos));
  706.     S^.Seek(IndexPos);
  707.     Index := PHelpIndex(S^.Get);
  708.     Modified := False;
  709.   end;
  710.   Stream := S;
  711. end;
  712.  
  713. destructor THelpFile.Done;
  714. var
  715.   Magic, Size: Longint;
  716. begin
  717.   if Modified then
  718.   begin
  719.     Stream^.Seek(IndexPos);
  720.     Stream^.Put(Index);
  721.     Stream^.Seek(0);
  722.     Magic := MagicHeader;
  723.     Size := Stream^.GetSize - 8;
  724.     Stream^.Write(Magic, SizeOf(Magic));
  725.     Stream^.Write(Size, SizeOf(Size));
  726.     Stream^.Write(IndexPos, SizeOf(IndexPos));
  727.   end;
  728.   Dispose(Stream, Done);
  729.   Dispose(Index, Done);
  730. end;
  731.  
  732.  {$IFDEF HelpExtensions}
  733.   var
  734.     OldTopics   : array [0..MaxOldTopics] of Word;
  735.     OldSelected : array [0..MaxOldTopics] of Integer;
  736.     OldFront    : Integer;
  737.     OldCount    : Integer;
  738.  {$ENDIF}
  739.  
  740. function THelpFile.GetTopic(I: Word): PHelpTopic;
  741.   var
  742.     Pos: Longint;
  743. begin
  744.  {$IFDEF HelpExtensions}
  745.   if I=PreviousTopic then   (* Show previous help *)
  746.     if OldCount=0 then
  747.       (* No previous topics *)
  748.       I:=0
  749.     else
  750.     begin
  751.       if HelpAlreadyPopped then
  752.       begin
  753.         (* Skip current (saved) topic *)
  754.         Dec(OldFront);
  755.         if OldFront<0 then
  756.           OldFront:=MaxOldTopics;
  757.         Dec(OldCount);
  758.       end;
  759.  
  760.       if HelpAlreadyPopped and (OldCount=0) then
  761.         (* No previous topic *)
  762.         I:=0
  763.       else
  764.         (* Get previous topic *)
  765.         I:=OldTopics[OldFront];
  766.     end
  767.   else
  768.     (* Don't save duplicate entries *)
  769.     if (OldCount=0) or (I<>OldTopics[OldFront]) then
  770.     begin
  771.       (* Save new topic in OldTopics stack *)
  772.       Inc(OldFront);
  773.       if OldFront>MaxOldTopics then
  774.         OldFront:=0;
  775.       OldTopics[OldFront]:=I;
  776.       if OldCount<MaxOldTopics then
  777.         Inc(OldCount);
  778.     end;
  779.  
  780.   HelpAlreadyPopped:=True;
  781.  {$ENDIF}
  782.  
  783.   Pos := Index^.Position(I);
  784.   if Pos > 0 then
  785.   begin
  786.     Stream^.Seek(Pos);
  787.     GetTopic := PHelpTopic(Stream^.Get);
  788.   end
  789.   else
  790.     GetTopic := InvalidTopic;
  791. end;
  792.  
  793. function THelpFile.InvalidTopic: PHelpTopic;
  794. var
  795.   Topic: PHelpTopic;
  796.   Para: PParagraph;
  797. const
  798.   InvalidStr = #13' No help available in this context.';
  799.   InvalidText: array[1..Length(InvalidStr)] of Char = InvalidStr;
  800. begin
  801.   Topic := New(PHelpTopic, Init);
  802.   GetMem(Para, SizeOf(Para^) + SizeOf(InvalidText));
  803.   Para^.Size := SizeOf(InvalidText);
  804.   Para^.Wrap := False;
  805.   Para^.Next := nil;
  806.   Move(InvalidText, Para^.Text, SizeOf(InvalidText));
  807.   Topic^.AddParagraph(Para);
  808.   InvalidTopic := Topic;
  809. end;
  810.  
  811. procedure THelpFile.RecordPositionInIndex(I: RefType);     { Int->Word fix }
  812. begin
  813.   Index^.Add(I, IndexPos);
  814.   Modified := True;
  815. end;
  816.  
  817. procedure THelpFile.PutTopic(Topic: PHelpTopic);
  818. begin
  819.   Stream^.Seek(IndexPos);
  820.   Stream^.Put(Topic);
  821.   IndexPos := Stream^.GetPos;
  822.   Modified := True;
  823. end;
  824.  
  825. { THelpViewer }
  826.  
  827. constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar,
  828.   AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
  829. begin
  830.   inherited Init(Bounds, AHScrollBar, AVScrollBar);
  831.   Options := Options or ofSelectable;
  832.   GrowMode := gfGrowHiX + gfGrowHiY;
  833.   HFile := AHelpFile;
  834.  {$IFDEF HelpExtensions}
  835.   Limit.X:=78;
  836.   Message(@Self, evCommand, cmSwitchToTopic, Pointer(Context));
  837.  {$ELSE}
  838.   Topic := AHelpFile^.GetTopic(Context);
  839.   Topic^.SetWidth(Size.X);
  840.   SetLimit(78, Topic^.NumLines);
  841.   Selected := 1;
  842.  {$ENDIF}
  843. end;
  844.  
  845. destructor THelpViewer.Done;
  846. begin
  847.   inherited Done;
  848.   Dispose(HFile, Done);
  849.   Dispose(Topic, Done);
  850. end;
  851.  
  852. procedure THelpViewer.ChangeBounds(var Bounds: TRect);
  853. begin
  854.   inherited ChangeBounds(Bounds);
  855.   Topic^.SetWidth(Size.X);
  856.   SetLimit(Limit.X, Topic^.NumLines);
  857. end;
  858.  
  859. procedure THelpViewer.Draw;
  860. var
  861.   B: TDrawBuffer;
  862.   Line: String;
  863.   I, J, L: Integer;
  864.   KeyCount: Integer;
  865.   Normal, Keyword, SelKeyword, C: Byte;
  866.   KeyPoint: TPoint;
  867.   KeyLength: Byte;
  868.   KeyRef: Word;
  869. begin
  870.   Normal := GetColor(1);
  871.   Keyword := GetColor(2);
  872.   SelKeyword := GetColor(3);
  873.   KeyCount := 0;
  874.   KeyPoint.X := 0;
  875.   KeyPoint.Y := 0;
  876.   Topic^.SetWidth(Size.X);
  877.   if Topic^.GetNumCrossRefs > 0 then
  878.     repeat
  879.       Inc(KeyCount);
  880.       Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
  881.     until (KeyCount >= Topic^.GetNumCrossRefs) or (KeyPoint.Y > Delta.Y);
  882.   for I := 1 to Size.Y do
  883.   begin
  884.     MoveChar(B, ' ', Normal, Size.X);
  885.     Line := Topic^.GetLine(I + Delta.Y);
  886.     MoveStr(B, Copy(Line, Delta.X+1, Size.X), Normal);
  887.     while I + Delta.Y = KeyPoint.Y do
  888.     begin
  889.       L := KeyLength;
  890.       if KeyPoint.X < Delta.X then
  891.       begin
  892.         Dec(L, Delta.X - KeyPoint.X);
  893.         KeyPoint.X := Delta.X;
  894.       end;
  895.       if KeyCount = Selected then C := SelKeyword
  896.       else C := Keyword;
  897.       for J := 0 to L-1 do
  898.         WordRec(B[KeyPoint.X - Delta.X + J]).Hi := C;
  899.       Inc(KeyCount);
  900.       if KeyCount <= Topic^.GetNumCrossRefs then
  901.         Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef)
  902.       else KeyPoint.Y := 0;
  903.     end;
  904.     WriteLine(0, I-1, Size.X, 1, B);
  905.   end;
  906. end;
  907.  
  908. function THelpViewer.GetPalette: PPalette;
  909. const
  910.   P: String[Length(CHelpViewer)] = CHelpViewer;
  911. begin
  912.   GetPalette := PPalette(@P);                      { Fix: Added cast }
  913. end;
  914.  
  915. procedure THelpViewer.HandleEvent(var Event: TEvent);
  916. var
  917.   KeyPoint, Mouse: TPoint;
  918.   KeyLength: Byte;
  919.   KeyRef: Word;
  920.   KeyCount: Integer;
  921.  
  922. procedure MakeSelectVisible;
  923. var
  924.   D: TPoint;
  925. begin
  926.   Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  927.   D := Delta;
  928.   if KeyPoint.X < D.X then D.X := KeyPoint.X
  929.   else if KeyPoint.X + KeyLength > D.X + Size.X then
  930.     D.X := KeyPoint.X + KeyLength - Size.X + 1;
  931.   if KeyPoint.Y <= D.Y then D.Y := KeyPoint.Y - 1;
  932.   if KeyPoint.Y > D.Y + Size.Y then D.Y := KeyPoint.Y - Size.Y;
  933.   if (D.X <> Delta.X) or (D.Y <> Delta.Y) then ScrollTo(D.X, D.Y);
  934. end;
  935.  
  936. procedure SwitchToTopic(KeyRef: Word);
  937. begin
  938.  {$IFDEF HelpExtensions}
  939.   if HFile^.HelpAlreadyPopped then
  940.     OldSelected[OldCount]:=Selected;
  941.  {$ENDIF}
  942.  
  943.   if Topic <> nil then
  944.     Dispose(Topic, Done);
  945.   Topic := HFile^.GetTopic(KeyRef);
  946.   Topic^.SetWidth(Size.X);
  947.   ScrollTo(0, 0);
  948.   SetLimit(Limit.X, Topic^.NumLines);
  949.   Selected := 1;
  950.  
  951.  {$IFDEF HelpExtensions}
  952.   if (KeyRef=PreviousTopic) and (OldSelected[OldCount]<>0) then
  953.   begin
  954.     Selected:=OldSelected[OldCount];
  955.     if Owner<>Nil then
  956.       Owner^.Lock;
  957.     DrawView;
  958.     if Selected<=Topic^.GetNumCrossRefs then
  959.       MakeSelectVisible;
  960.     if Owner<>Nil then
  961.       Owner^.Unlock;
  962.   end
  963.   else
  964.  {$ENDIF}
  965.     DrawView;
  966. end;
  967.  
  968. begin
  969.   inherited HandleEvent(Event);
  970.   case Event.What of
  971.     evKeyDown:
  972.       begin
  973.         case Event.KeyCode of
  974.           kbTab:
  975.             if Topic^.GetNumCrossRefs > 0 then
  976.             begin
  977.               Inc(Selected);
  978.               if Selected > Topic^.GetNumCrossRefs then Selected := 1;
  979.               MakeSelectVisible;
  980.             end;
  981.           kbShiftTab:
  982.             if Topic^.GetNumCrossRefs > 0 then
  983.             begin
  984.               Dec(Selected);
  985.               if Selected = 0 then Selected := Topic^.GetNumCrossRefs;
  986.               MakeSelectVisible;
  987.             end;
  988.           kbEnter:
  989.             if Selected <= Topic^.GetNumCrossRefs then
  990.             begin
  991.               Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  992.               SwitchToTopic(KeyRef);
  993.             end;
  994.           kbEsc:
  995.             begin
  996.               Event.What := evCommand;
  997.               Event.Command := cmClose;
  998.               PutEvent(Event);
  999.             end;
  1000.         else
  1001.           Exit;
  1002.         end;
  1003.         DrawView;
  1004.         ClearEvent(Event);
  1005.       end;
  1006.     evMouseDown:
  1007.       begin
  1008.         MakeLocal(Event.Where, Mouse);
  1009.         Inc(Mouse.X, Delta.X); Inc(Mouse.Y, Delta.Y);
  1010.         KeyCount := 0;
  1011.         repeat
  1012.           Inc(KeyCount);
  1013.           if KeyCount > Topic^.GetNumCrossRefs then Exit;
  1014.           Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
  1015.         until (KeyPoint.Y = Mouse.Y+1) and (Mouse.X >= KeyPoint.X) and
  1016.           (Mouse.X < KeyPoint.X + KeyLength);
  1017.         Selected := KeyCount;
  1018.         DrawView;
  1019.         if Event.Double then SwitchToTopic(KeyRef);
  1020.         ClearEvent(Event);
  1021.       end;
  1022.     evCommand:
  1023.       if (Event.Command = cmClose) and (Owner^.State and sfModal <> 0) then
  1024.       begin
  1025.        {$IFDEF HelpExtensions}
  1026.         OldSelected[OldCount]:=Selected;
  1027.        {$ENDIF}
  1028.         EndModal(cmClose);
  1029.         ClearEvent(Event);
  1030.       end
  1031.       {$IFDEF HelpExtensions}
  1032.       else
  1033.         if Event.Command=cmSwitchToTopic then
  1034.           SwitchToTopic(Event.InfoWord);
  1035.       {$ENDIF}
  1036.   end;
  1037. end;
  1038.  
  1039. { THelpWindow }
  1040.  
  1041. constructor THelpWindow.Init(HFile: PHelpFile; Context: Word);
  1042. var
  1043.   R: TRect;
  1044. begin
  1045.   R.Assign(0, 0, 50, 18);
  1046.   TWindow.Init(R, 'Help', wnNoNumber);
  1047.   Options := Options or ofCentered;
  1048.   R.Grow(-2,-1);
  1049.   Insert(New(PHelpViewer, Init(R,
  1050.     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  1051.     StandardScrollBar(sbVertical + sbHandleKeyboard), HFile, Context)));
  1052. end;
  1053.  
  1054. function THelpWindow.GetPalette: PPalette;
  1055. const
  1056.   P: String[Length(CHelpWindow)] = CHelpWindow;
  1057. begin
  1058.   GetPalette := PPalette(@P);                           { Fix: Added cast }
  1059. end;
  1060.  
  1061. procedure RegisterHelpFile;
  1062. begin
  1063.   RegisterType(RHelpTopic);
  1064.   RegisterType(RHelpIndex);
  1065. end;
  1066.  
  1067. procedure NotAssigned(var S: TStream; Value: RefType);     { Int->Word fix }
  1068. begin
  1069. end;
  1070.  
  1071. end.
  1072.